The Original Shareware 1.1/The Original Shareware (WeMake CDs)(Volume 1.1)(CDs, Inc)(1993).iso/32/five.zip/FIVE.PAS

Pascal/Delphi Source File | 1987-03-14 | 45KB | 1,242 lines

Program Five_thousand;

    Const Max_players = 15;

    Type Strategy = (Human,Comp_1,Comp_2,Comp_3);
         Scores = record
                       Points:         real;
                       Scratches:      real;
                       Player_name:    string[20];
                       Player_type:    strategy;
                       On_board:       boolean;
                    end;
         Die = record
                    Value:   integer;
                    Pulled:  boolean;
                    Saved:   boolean;
                    Marked:  boolean;
                 end;
         Dice = array[1..6] of Die;


    Var Winnings:            array[1..Max_players] of real;
        Losses:              array[1..Max_players] of real;
        Score:               array[0..Max_players] of Scores;
        Last_player:         integer;
        Current_player:      integer;
        Next_player:         integer;
        Needed:              real;
        Last_players_score:  real;
        Games_played:        integer;
        Silent:              boolean;
        Number_of_players:   integer;
        Cup:                 Dice;
        Humans_want_to_play: boolean;
        Someone_over:        boolean;
        Problems:            boolean;
        Ch:                  char;
        index:               integer;

    Procedure Randomize;

         Var Reg_set:  record
                            Ax:        integer;
                            Bx:        integer;
                            Cx:        integer;
                            Dx:        integer;
                            Bp:        integer;
                            Si:        integer;
                            Di:        integer;
                            Ds:        integer;
                            Es:        integer;
                            Flags:     integer;
                         end;
             I:    integer;
             J:    integer;
             K:    integer;

         begin
         Reg_set.Ax:= $2C00;
         MSDos(Reg_set);
         J:= Reg_set.Cx;
         I:= Reg_set.Dx;
         MemW[Dseg:$0129]:= I;
         MemW[Dseg:$012B]:= J;
         For i:= 1 to J mod 250 do
              k:= random(i);
         end;

    Procedure Display_all_players;

         Var Player:    integer;

         begin
         window(36,2,78,24);
         clrscr;
         gotoxy(1,1);
         writeln;
         writeln('        PLAYERS AND THEIR SCORES');
         writeln;
         writeln;
         writeln('     Name                  Score  Scratches');
         for Player:= 1 to Number_of_players do
              begin
              write(Player:2,': ',Score[Player].Player_name);
              gotoxy(25,6 + Player);
              writeln(Score[Player].Points:8:0,'    ',
                      Score[Player].Scratches:5:0);
              end;

         if Number_of_players < 14
              then
                 begin
                 writeln;
                 writeln;
                 end
              else
                 if Number_of_players <=14
                      then
                         writeln;
         if Number_of_players < 8
              then
                 gotoxy(1,17);

         writeln('The last player was: ',Score[Last_player].Player_name);
         if Last_player <> 0
             then
                begin
                write('Their score was: ');
                textcolor(black);
                textbackground(white);
                write(Last_players_score:8:0);
                textcolor(white);
                textbackground(black);
                end;
         end;

    Procedure Border;

         Const Horiz =         #205;
               Vert =          #186;
               Top_left =      #201;
               Top_right =     #187;
               Bottom_left =   #200;
               Bottom_right =  #188;
               Top_center =    #209;
               Bottom_center = #207;
               Center =        #179;

         Var x_pos:     integer;
             y_pos:     integer;

         begin
         window(1,1,80,25);
         clrscr;
         For x_pos:= 1 to 79 do
              write(Horiz);
         gotoxy(1,25);
         For x_pos:= 1 to 79 do
              write(Horiz);
         x_pos:= 1;
         For y_pos:= 2 to 24 do
              begin
              gotoxy(x_pos,y_pos);
              write(Vert);
              end;
         x_pos:= 79;
         For y_pos:= 2 to 24 do
              begin
              gotoxy(x_pos,y_pos);
              write(Vert);
              end;
         gotoxy(1,1);
         write(Top_left);
         gotoxy(79,1);
         write(Top_right);
         gotoxy(35,1);
         write(Top_center);
         gotoxy(1,25);
         write(Bottom_left);
         gotoxy(79,25);
         write(Bottom_right);
         gotoxy(35,25);
         write(Bottom_center);
         x_pos:= 35;
         For y_pos:= 2 to 24 do
              begin
              gotoxy(x_pos,y_pos);
              write(Center);
              end;
         end;

    Procedure Initialize_all;

         Var index:     integer;

         begin
         Problems:= False;
         Last_player:= 0;
         Current_player:= 0;
         Next_player:= 0;
         Games_played:= 0;
         Number_of_players:= 0;
         Last_players_score:= 0.0;
         Textcolor(white);
         Textbackground(black);
         For index:= 1 to Max_players do
              begin
              Winnings[index]:= 0.0;
              Losses[index]:= 0.0;
              with Score[index] do
                   begin
                   Points:= 0.0;
                   Scratches:= 0;
                   Player_name:='not yet assigne....d';
                   Player_type:= Human;
                   On_board:= False;
                   end;
              end;
         with Score[0] do
              begin
              Points:= 0.0;
              Scratches:= 0;
              Player_name:= 'New Game';
              Player_type:= Human;
              On_board:= False;
              end;
         Border;
         Display_all_players;
         end;

    Procedure Show_dice(Var Cup: Dice);

         Var Top:            string[3];
             Bottom:         string[3];
             Middle:         string[3];
             Die_number:     integer;
             Top_line:       integer;
             X_pos:          integer;
             Line:           integer;

         begin
         Top:= #218 + #196 +#191;
         Bottom:= #192 + #196 + #217;
         for line:= 11 to 13 do
              begin
              gotoxy(1,line);
              clreol;
              end;
         for line:= 19 to 21 do
              begin
              gotoxy(1,line);
              clreol;
              end;
         For Die_number:= 1 to 6 do
              begin
              If Cup[Die_number].Saved
                  then
                     Top_line:= 11
                  else
                     Top_line:= 19;
              if Cup[Die_number].Pulled
                   then
                      begin
                      Textcolor(black);
                      Textbackground(white);
                      end;
              x_pos:= 5 * (Die_number);
              gotoxy(x_pos,Top_line);
              write(Top);
              gotoxy(x_pos,Top_line + 1);
              write(#179,Cup[Die_number].Value:1,#179);
              gotoxy(x_pos,Top_line + 2);
              write(Bottom);
              if Cup[Die_number].Pulled
                   then
                      begin
                      Textcolor(white);
                      Textbackground(black);
                      end;
              end;
         end;


    Procedure Turn_stats(Saved_points,Points_available:real);


         begin
         window(2,2,34,23);
         clrscr;
         writeln;
         writeln('   Current Player Information');
         writeln;
         writeln('Player: ',Score[Current_player].Player_name);
         writeln;
         write('On the board? ');
         if Score[Current_player].On_board
              then
                 writeln('YES')
              else
                 begin
                 Textcolor(Black);
                 Textbackground(White);
                 writeln('NO');
                 Textcolor(White);
                 Textbackground(Black);
                 end;
         write('Points needed: ');
         Needed:= Last_players_score + 50.0;
         if Score[Current_player].On_board and (Needed <= 350.0)
              then
                 Needed:= 350.0;
         if (not Score[Current_player].On_board) and (Needed <= 500.0)
              then
                 Needed:= 500.0;
         writeln('          ',Needed:6:0);
         writeln('The points available are: ',Points_available:5:0);
         writeln;
         writeln('Dice_saved:');
         gotoxy(1,15);
         writeln('Value of the dice saved:  ',Saved_points:5:0);
         writeln;
         writeln;
         writeln('The dice on the table are:');
         end;

    Procedure Test_cup;

          Var i:   integer;
          begin
          Randomize;
          For i:= 1 to 6 do
               begin
               Cup[i].Saved:= False;
               Cup[i].Marked:= False;
               end;
          Cup[1].Value:= 2;
          Cup[2].Value:= 2;
          Cup[3].Value:= 2;
          Cup[4].Value:= 2;
          Cup[5].Value:= 2;
          Cup[6].Value:= 2;
          end;

    Function Score_pulled(Var Cup:Dice):real;

         Var Points_this_pass:    real;
             i:                   integer;
             j:                   integer;
             Count:               integer;
             Talley:              array[1..6] of integer;
             Ones:                integer;
             Twos:                integer;
             Threes:              integer;
             Fours:               integer;
             Fivers:               integer;
             Sixes:               integer;

         Function Aces(Var Cup:Dice):real;

              Var i:    integer;
                  Count:integer;

              begin
              count:= 0;
              For i:= 1 to 6 do
                   if ((Cup[i].Value = 1) and Cup[i].Pulled) and
                                              not (Cup[i].Marked)
                        then
                           begin
                           Cup[i].Marked:= True;
                           Count:= Count + 1;
                           end;
              Aces:= 100.0 * Count;
              end;

         Function Fives(Var Cup:Dice):real;

              Var i:    integer;
                  Count:integer;

              begin
              count:= 0;
              For i:= 1 to 6 do
                   if ((Cup[i].Value = 5) and Cup[i].Pulled) and
                                              not (Cup[i].Marked)
                        then
                           begin
                           Cup[i].Marked:= True;
                           Count:= Count + 1;
                           end;
              Fives:= 50.0 * Count;
              end;

         Procedure Anomaly(Var Cup:Dice);

              Var Point:     real;
                  Count:     integer;
                  I:         integer;
                  J:         integer;

              begin
              for i:= 1 to 6 do
                   Cup[I].Marked:= False;
              i:= 1;
              while Talley[I] <> 4 do
                   I:= I + 1;
              Point:= 100.0 * I;
              if I = 1
                   then
                      Point:= 1000.0;
              Count:= 0;
              for J:= 1 to 6 do
                   begin
                   if (Cup[J].Value = I) and (Count < 3)
                        then
                           begin
                           Cup[J].Marked:= True;
                           Count:= Count + 1;
                           end;
                   end;
              Point:= Point + Aces(Cup) + fives(Cup);
              for I:= 1 to 6 do
                   begin
                   if not Cup[I].Marked
                        then
                           Count:= -1;
                   Cup[I].Marked:= True;
                   end;
              if Count < 0
                   then
                      Point:= 0.0;
              if Point > 500
                   then
                      Points_this_pass:= Point;

              end;


         begin
         Count:= 0;
         Points_this_pass:= 0.0;
         fillchar(Talley,Sizeof(Talley),0);
         for i:= 1 to 6 do
              if (not Cup[i].saved) and Cup[i].Pulled
                   then
                      begin
                      Count:= Count + 1;
                      Talley[Cup[i].Value]:= Talley[Cup[i].Value] + 1;
                      Cup[i].Marked:= False;
                      end;
         if Count >0
              then
                 begin
                 Ones:= 0;
                 Twos:= 0;
                 Threes:= 0;
                 Fours:= 0;
                 Fivers:= 0;
                 Sixes:= 0;
                 for i:= 1 to 6 do
                      Case Talley[i] of
                           1: Ones:= Ones + 1;
                           2: Twos:= Twos + 1;
                           3: Threes:= Threes + 1;
                           4: Fours:= Fours + 1;
                           5: Fivers:= Fivers + 1;
                           6: Sixes:= Sixes + 1;
                        end;
                 if Ones = 6
                      then
                         begin
                         Points_this_pass:= 1500;
                         for i:= 1 to 6 do
                              Cup[i].Marked:= true;
                         end;
                 if (Twos = 3) or ((Twos = 1) and (Fours = 1))
                      then
                         begin
                         Points_this_pass:= 500;
                         for i:= 1 to 6 do
                              Cup[i].Marked:= True;
                         end;
                 if Sixes = 1
                      then
                         begin
                         i:= 1;
                         while Talley[i] <>6 do
                         i:= i + 1;
                         Points_this_pass:= 2 * 100.0 * i;
                         if i = 1
                              then
                                 Points_this_pass:= 2000.0;
                         for i:= 1 to 6 do
                              if Cup[i].Pulled
                                   then
                                      Cup[i].Marked:= True;
                         end;
                 if Fours = 1
                      then
                         begin
                         i:= 1;
                         while Talley[i] <>4 do
                              i:= i + 1;
                         Count:= 0;
                         for j:= 1 to 6 do
                              if(Cup[J].Value = I) and (not Cup[J].Marked)
                                   then
                                      Count:= Count + 1;
                         if Count >= 3
                              then
                                 begin
                                 Points_this_pass:= 100.0 * i;
                                 if i = 1
                                      then
                                         Points_this_pass:= 1000.0;
                                 Count:= 0;
                                 for j:= 1 to 6 do
                                     begin
                                     if (Cup[j].Value = i) and
                                               (Count < 3) and
                                               (Cup[j].Pulled) and
                                               (not Cup[J].Marked)
                                          then
                                             begin
                                             Cup[j].Marked:= True;
                                             Count:= Count + 1;
                                             end;
                                     end;
                              end;
                         end;
                 if (Twos = 1) and (Fours = 1)
                      then
                         anomaly(Cup);
                 if Threes > 0
                      then
                         begin
                         Threes:= Threes - 1;
                         i:= 1;
                         while Talley[i] <>3 do
                         i:= i + 1;
                         Points_this_pass:= 100.0 * i;
                         If i = 1
                              then
                                 Points_this_pass:= 1000.0;
                         for j:= 1 to 6 do
                              if (Cup[j].Value = i) and Cup[j].Pulled
                                   then
                                      Cup[j].Marked:= True;
                         end;
                 if Threes = 1
                      then
                         begin
                         i:= i + 1;
                         while Talley[i] <>3 do
                         i:= i + 1;
                         Points_this_pass:= 100.0 * i + Points_this_pass;
                         If i = 1
                              then
                                 Points_this_pass:= 1000.0 + Points_this_pass;
                         for j:= 1 to 6 do
                              if (Cup[j].Value = i) and Cup[j].Pulled
                                   then
                                      Cup[j].Marked:= True;
                         end;


                 if fivers = 1
                      then
                         begin
                         i:= 1;
                         while Talley[i] <>5 do
                              i:= i + 1;
                              Points_this_pass:= 100.0 * i;
                              If i = 1
                                   then
                                      Points_this_pass:= 1000.0;
                              Count:= 0;
                              for j:= 1 to 6 do
                                   if (Cup[j].Value = i) and (Count < 3) and
                                                             (Cup[j].Pulled)
                                             then
                                                begin
                                                Cup[j].Marked:= True;
                                                Count:= Count + 1;
                                                end;
                         end;
                 Points_this_pass:= Points_this_pass + Aces(Cup) + Fives(Cup);
                 end;
         for i:= 1 to 6 do
              if (Cup[i].Pulled) and not Cup[i].Marked
                   then
                      Points_this_pass:= -1.0;
         for i:= 1 to 6 do
              Cup[i].Marked:= False;
         Score_pulled:= Points_this_pass;
         end;

    Function Score_unsaved(Var Cup:Dice):real;

         Var Points_this_pass:    real;
             i:                   integer;
             j:                   integer;
             Count:               integer;
             Talley:              array[1..6] of integer;
             Ones:                integer;
             Twos:                integer;
             Threes:              integer;
             Fours:               integer;
             Fivers:               integer;
             Sixes:               integer;

         Function Aces(Var Cup:Dice):real;

              Var i:    integer;
                  Count:integer;

              begin
              count:= 0;
              For i:= 1 to 6 do
                   if ((Cup[i].Value = 1) and not Cup[i].Saved) and
                                              not (Cup[i].Marked)
                        then
                           begin
                           Cup[i].Marked:= True;
                           Count:= Count + 1;
                           end;
              Aces:= 100.0 * Count;
              end;

         Function Fives(Var Cup:Dice):real;

              Var i:    integer;
                  Count:integer;

              begin
              count:= 0;
              For i:= 1 to 6 do
                   if ((Cup[i].Value = 5) and not Cup[i].Saved) and
                                              not (Cup[i].Marked)
                        then
                           begin
                           Cup[i].Marked:= True;
                           Count:= Count + 1;
                           end;
              Fives:= 50.0 * Count;
              end;

         Procedure Anomaly;

              begin
              end;


         begin
         Count:= 0;
         Points_this_pass:= 0.0;
         fillchar(Talley,Sizeof(Talley),0);
         for i:= 1 to 6 do
              if not Cup[i].saved
                   then
                      begin
                      Count:= Count + 1;
                      Talley[Cup[i].Value]:= Talley[Cup[i].Value] + 1;
                      Cup[i].Marked:= False;
                      end;
         if Count >0
              then
                 begin
                 Ones:= 0;
                 Twos:= 0;
                 Threes:= 0;
                 Fours:= 0;
                 Fivers:= 0;
                 Sixes:= 0;
                 for i:= 1 to 6 do
                      Case Talley[i] of
                           1: Ones:= Ones + 1;
                           2: Twos:= Twos + 1;
                           3: Threes:= Threes + 1;
                           4: Fours:= Fours + 1;
                           5: Fivers:= Fivers + 1;
                           6: Sixes:= Sixes + 1;
                        end;
                 if Ones = 6
                      then
                         begin
                         Points_this_pass:= 1500;
                         for i:= 1 to 6 do
                              Cup[i].Marked:= true;
                         end;
                 if Twos = 3
                      then
                         begin
                         Points_this_pass:= 500;
                         for i:= 1 to 6 do
                              Cup[i].Marked:= True;
                         end;
                 if Sixes = 1
                      then
                         begin
                         i:= 1;
                         while Talley[i] <>6 do
                         i:= i + 1;
                         Points_this_pass:= 2 * 100.0 * i;
                         if i = 1
                              then
                                 Points_this_pass:= 2000.0;
                         for i:= 1 to 6 do
                              if not Cup[i].Saved
                                   then
                                      Cup[i].Marked:= True;
                         end;
                 if Fours = 1
                      then
                         begin
                         i:= 1;
                         while Talley[i] <>4 do
                              i:= i + 1;
                         Points_this_pass:= 100.0 * i;
                         if i = 1
                              then
                                 Points_this_pass:= 1000.0;
                         Count:= 0;
                         for j:= 1 to 6 do
                              begin
                              if (Cup[j].Value = i) and (Count < 3) and
                                                      (Cup[j].Pulled)
                                        then
                                           begin
                                           Cup[j].Marked:= True;
                                           Count:= Count + 1;
                                           end;
                              end;
                         end;
                 if (Twos = 3) and (Fours = 1)
                      then
                         anomaly;
                 if Threes > 0
                      then
                         begin
                         Threes:= Threes - 1;
                         i:= 1;
                         while Talley[i] <>3 do
                         i:= i + 1;
                         Points_this_pass:= 100.0 * i;
                         If i = 1
                              then
                                 Points_this_pass:= 1000.0;
                         for j:= 1 to 6 do
                              if (Cup[j].Value = i) and Cup[j].Pulled
                                   then
                                      Cup[j].Marked:= True;
                         end;
                 if Threes = 1
                      then
                         begin
                         i:= i + 1;
                         while Talley[i] <>3 do
                         i:= i + 1;
                         Points_this_pass:= 100.0 * i + Points_this_pass;
                         If i = 1
                              then
                                 Points_this_pass:= 1000.0 + Points_this_pass;
                         for j:= 1 to 6 do
                              if (Cup[j].Value = i) and Cup[j].Pulled
                                   then
                                      Cup[j].Marked:= True;
                         end;


                 if fivers = 1
                      then
                         begin
                         i:= 1;
                         while Talley[i] <>5 do
                              i:= i + 1;
                              Points_this_pass:= 100.0 * i;
                              If i = 1
                                   then
                                      Points_this_pass:= 1000.0;
                              Count:= 0;
                              for j:= 1 to 6 do
                                   if (Cup[j].Value = i) and (Count < 3) and
                                                             (Cup[j].Pulled)
                                             then
                                                begin
                                                Cup[j].Marked:= True;
                                                Count:= Count + 1;
                                                end;
                         end;
                 Points_this_pass:= Points_this_pass + Aces(Cup) + Fives(Cup);
                 end;

         for i:= 1 to 6 do
              Cup[i].Marked:= False;
         Score_unsaved:= Points_this_pass;
         end;

    Procedure Start_it_off;

         Var Player:    integer;
             Name:      string[100];
             Ok:        boolean;
             Result:    integer;
             Ch:        char;

         Procedure Instructions;
{$I Instruct.pas }

         begin
         Ok:= False;
         Initialize_all;
         window(2,2,34,24);
         clrscr;
         writeln;
         writeln('              5,000');
         writeln;
         writeln('Welcome to a game of skill and');
         write('Chance. The dice are HOT, so I''ll');
         writeln('handle them for you. I also');
         write('assume that you wish to play this');
         writeln('game for money--the stakes are:');
         writeln('a Quarter a game, and a Dime a');
         writeln('scratch.');
         writeln;
         writeln;
         write('Do you need an introduction? ');
         read(kbd,Ch);
         if upcase(Ch) = 'Y'
              then
                 Instructions;
         repeat
              gotoxy(1,13);
              clreol;
              write('How many players (1-15)?- ');
              readln(Name);
              Name:= copy(Name,1,2);
              val(Name,Number_of_players,Result);
         until (Number_of_players > 0) and
               (Number_of_players < 16) and
               (Result = 0);
         writeln;
         writeln('Now I need your names. If you');
         writeln('want me to play, call me Comp1,');
         writeln('Comp2, or Comp3.');
         writeln;
         for Player:= 1 to Number_of_players do
              begin
              Name:= '';
              repeat
                   gotoxy(1,19);
                   clreol;
                   write('Player No. ',Player:2,' ');
                   readln(Name);
                   if copy(Name,1,5) = 'Comp1'
                        then
                           Score[Player].Player_type:= Comp_1;
                   if copy(Name,1,5) = 'Comp2'
                        then
                           Score[Player].Player_type:= Comp_2;

                   {if (Name = 'Comp3')
                        then
                           begin
                           Ok:= False;
                           gotoxy(1,19);
                           write('I''m sorry, I have a headache');
                           Delay(1500);
                           Name:= '';
                           end;}
                   if copy(Name,1,5) = 'Comp3'
                        then
                           Score[Player].Player_type:= Comp_3;

                   Ok:= Name <> '';
              until Ok;
              Score[Player].Player_name:= copy(Name,1,20);
              Display_all_players;
              window(2,2,34,24);
              end;
         gotoxy(1,19);
         clreol;
         Current_player:= random(Number_of_players) + 1;
         writeln('I''ve randomly chosen the first');
         writeln('player:  ',Score[Current_player].Player_name);
         writeln;
         writeln('Good luck ladies and gentlemen!');
         delay(2500);
         end;


    Procedure Play_a_hand(Player:integer);

         Var Pulled_score:        real;
             Points_saved:        real;
             Points_available:    real;
             I:                   integer;
             Count:               integer;
             Scratch:             boolean;
             Chicken:             boolean;
             First_roll:          boolean;
             Ch:                  char;

{$I Computer.Pas }

         Procedure Pull_dice(Var Cup:Dice);

              Const Pointer = '^';
                    Pointer_loc: array[1..6] of integer = (6,11,16,21,26,31);
                    Left = #075;
                    Right = #077;
                    Space = ' ';
                    Rtn = #013;
                    Esc = #027;
                    Line = 22;

              Var x_pos:     integer;
                  I:         integer;
                  Ch:        char;
                  All_done:  boolean;

              begin
              I:= 0;
              All_done:= False;
              repeat
                   I:= I + 1;
              until (I = 6) or (not Cup[I].Saved);
              gotoxy(1,Line);
              clreol;
              repeat
                   x_pos:= Pointer_loc[I];
                   gotoxy(x_pos,Line);
                   write(Pointer);
                   read(kbd,Ch);
                   if (Ch = Esc) and keypressed
                        then
                           read(kbd,Ch);
                   case upcase(Ch) of
                        Left: begin
                              gotoxy(x_pos,Line);
                              write(' ');
                              repeat
                                   I:= I - 1;
                                   if I < 1
                                        then
                                           I:= 6;
                              until not Cup[I].Saved;
                              x_pos:= Pointer_loc[I];
                              gotoxy(x_pos,Line);
                              write(' ');
                              end;
                       Right: begin
                              gotoxy(x_pos,Line);
                              write(' ');
                              repeat
                                   I:= I + 1;
                                   if I > 6
                                        then
                                           I:= 1;
                              until not Cup[i].Saved;
                              x_pos:= Pointer_loc[I];
                              gotoxy(x_pos,Line);
                              write(' ');
                              end;
                         ' ': if Cup[I].Pulled
                                   then
                                      Cup[I].Pulled:= False
                                   else
                                      Cup[I].Pulled:= True;
                         Rtn:All_done:= True;
                      end;
                   Show_dice(Cup);
              until All_done;
              gotoxy(1,line);
              clreol;
              end;


         begin
         Points_saved:= 0.0;
         Points_available:= 0.0;
         Scratch:= False;
         First_roll:= True;
         Problems:= False;
         Chicken:= False;
         Ch:= 'N';
         for I:= 1 to 6 do
              begin
              Cup[I].Pulled:= False;
              Cup[I].Saved:= False;
              end;
         Turn_stats(Points_saved,Points_available);
         Show_dice(Cup);
         repeat
              if (Points_available < Needed) and
                      (Score[Current_player].Player_type = Human)
                   then
                      begin
                      gotoxy(1,22);
                      write('Press any key to roll dice');
                      repeat
                           I:= random(6) + 1;
                      until keypressed;
                      end;
              gotoxy(1,22);
              clreol;
              for I:= 1 to 6 do
                   if not Cup[I].Saved
                        then
                           Cup[I].Value:= random(6) + 1;
              Show_dice(Cup);
              Scratch:= (Score_unsaved(Cup) = 0.0);
              if First_roll and Scratch
                   then
                      Score[Current_player].Scratches:=
                           Score[Current_player].Scratches + 1;
              First_roll:= False;
              if not Scratch
                   then
                      begin
                      repeat
                           if Score[Current_player].Player_type = Human
                                then
                                   Pull_dice(Cup)
                                else
                                   begin
                                   Chicken:= Computer_player(Cup);
                                   if Chicken
                                        then
                                           Ch:= 'Y'
                                        else
                                           Ch:= 'N';
                                   Show_dice(Cup);
                                   Delay(3000)
                                   end;
                           Pulled_score:= Score_pulled(Cup);
                           Problems:= False;
                           if Pulled_score < 0.0
                                then
                                   begin
                                   gotoxy(1,22);
                                   write('All pulled dice do not SCORE',#007);
                                   delay(1500);
                                   Problems:= True;
                                   for I:= 1 to 6 do
                                        Cup[I].Pulled:= False;
                                   end;
                           if Pulled_score = 0.0
                                then
                                   begin
                                   gotoxy(1,22);
                                   write('You must pull a Score!');
                                   delay(1500);
                                   Problems:= True;
                                   end;
                      until Pulled_score > 0.0;
                      Points_saved:= Points_saved + Pulled_score;
                      Points_available:= Points_available + Pulled_score;
                      for I:= 1 to 6 do
                           if Cup[I].Pulled
                                then
                                   begin
                                   Cup[I].Saved:= True;
                                   Cup[I].Pulled:= False;
                                   end;
                      Turn_stats(Points_saved,Points_available);
                      Show_dice(Cup);
                      if Score[Current_player].Player_type = Human
                           then
                              if Points_available >= Needed
                                   then
                                      repeat
                                           gotoxy(1,22);
                                           clreol;
                                           write('Quit while you''re ahead? ');
                                           read(kbd,Ch);
                                      until (upcase(Ch) = 'Y') or
                                                     (upcase(Ch) = 'N');
                      Chicken:= (upcase(Ch) = 'Y');
                      end;
              Count:= 0;
              for I:= 1 to 6 do
                   if Cup[I].Saved
                        then
                           Count:= Count + 1;
              if Count = 6
                   then
                      begin
                      Points_saved:= 0.0;
                      for I:= 1 to 6 do
                           Cup[I].Saved:= false;
                      end;
         until Scratch or Chicken;
         if Scratch
              then
                 begin
                 Last_players_score:= 0.0;
                 Score[Current_player].Scratches:=
                                       Score[Current_player].Scratches + 1;
                 gotoxy(10,22);
                 write('TOO BAD.. YOU SCRATCHED');
                 delay(1500);
                 end
              else
                 begin
                 if Points_available >= 500.0
                      then
                         Score[Current_player].On_board:= True;
                 Last_players_score:= Points_available;
                 Score[Current_player].Points:=
                      Score[Current_player].Points + Points_available;
                 if Score[Current_player].Points > Score[0].Points
                      then
                         Score[0].Points:= Score[Current_player].Points;
                 end;
         end;

    Procedure Play_a_game;

         Var Whose_over:          integer;
             Max_score:           real;
             Winner:              integer;
             Player:              integer;

         begin
         Someone_over:= False;
         repeat
              Play_a_hand(Current_player);
              if Score[Current_player].Points >= 5000.0
                   then
                      begin
                      Someone_over:= True;
                      Whose_over:= Current_player;
                      end
                   else
                      Last_player:= Current_player;
                      Current_player:= Current_player + 1;
                      if Current_player > Number_of_players
                           then
                              Current_player:= 1;
              Last_player:= Current_player - 1;
              if Last_player = 0
                   then
                      Last_Player:= Number_of_players;
              Display_all_players;
         until Someone_over;
         repeat
              Play_a_hand(Current_player);
              Last_player:= Current_player;
              Current_player:= Current_player + 1;
              if Current_player > Number_of_players
                   then
                      Current_player:= 1;
              Display_all_players;
         until Current_player = Whose_over;
         Max_score:= Last_players_score;
         for Player:= 1 to Number_of_players do
              if Score[Player].Points > Max_score
                   then
                      begin
                      Winner:= Player;
                      Max_score:= Score[Player].Points;
                      end;
         Current_player:= Winner;
         Last_player:= 0;
         Last_players_score:= 0.0;
         end;

    Procedure Show_winnings;

         Type Ending = (win,lose);

         Var Pay_off:        array[win..lose,1..Max_players] of real;
             Winner_gets:    real;
             Player:         integer;
             Played_to:      ending;

         begin
         Winner_gets:= 0.0;
         fillchar(Pay_off,sizeof(Pay_off),0);
         for Player:= 1 to Number_of_players do
              begin
              if Player <> Current_player
                   then
                      Played_to:= lose
                   else
                      Played_to:= win;
              Pay_off[Played_to,Player]:= 0.25 + 0.1 * Score[Player].Scratches;
              if Score[Player].Points = 0.0
                   then
                      Pay_off[Played_to,Player]:= Pay_off[Played_to,Player]*2;
              Winner_gets:= Winner_gets + Pay_off[Played_to,Player];
              end;
         Winner_gets:= Winner_gets - 0.25 -
                              0.1 * Score[Current_player].Scratches;
         Pay_off[win,Current_player]:= Winner_gets;
         for Player:= 1 to Number_of_players do
              begin
              Winnings[Player]:= Pay_off[win,Player] + Winnings[Player];
              Losses[Player]:= Pay_off[lose,Player] + Losses[Player];
              end;
         window(2,2,34,24);
         clrscr;
         writeln;
         writeln;
         writeln('Here''s the results of this game:');
         writeln;
         writeln(' Player               Wins  Loses');
         for Player:= 1 to Number_of_players do
              begin
              write(Player:2,' ',Score[Player].Player_name);
              gotoxy(23,Player  + 6);
              write('$',Pay_off[win,Player]:4:2,' $',Pay_off[lose,Player]:4:2);
              end;
         window(36,2,78,24);
         clrscr;
         gotoxy(1,1);
         writeln;
         writeln('      PLAYERS AND THEIR WINNINGS');
         writeln;
         writeln;
         writeln('     Name              Winnings  Losses');
         writeln;
         for Player:= 1 to Number_of_players do
              begin
              write(Player:2,': ',Score[Player].Player_name);
              gotoxy(25,6 + Player);
              writeln('$',Winnings[Player]:5:2,'   $',
                      Losses[Player]:5:2);
              end;
         write('The number of games Played = ',Games_played:4);
         end;

    begin
    Randomize;
    Start_it_off;
    Test_cup;
    Humans_want_to_play:= True;
    while Humans_want_to_play do
         begin
         Play_a_game;
         Games_played:= Games_played + 1;
         Show_winnings;
         repeat
              gotoxy(1,22);
              clreol;
              write('  Do you want to play again? ');
              read(kbd,Ch);
              Ch:= upcase(Ch);
         until (Ch = 'Y') or (Ch = 'N');
         if Ch = 'N'
              then
                 Humans_want_to_play:= False;
         for index:= 1 to Number_of_players do
              with Score[index] do
                   begin
                   Points:= 0.0;
                   Scratches:= 0;
                   On_board:= False;
                   end;
         end;
    end.